*--------------------------------------------------------------;
* Selects a two-stage cluster sample from a sas data set       ;
* frame.                                                       ;
*--------------------------------------------------------------;
%macro cl2(noprint,frame=,cluster=,setup=,npop=,n=,mpopi=,
  mi=,sample=,seed=);
  %if %length(&seed)    = 0 %then %let seed    = %str(0);
  %if %length(&cluster) = 0 %then %let cluster =cluster;
  %if %length(&frame)   = 0 %then %let frame   = %str(frame);
  %if %length(&sample)  = 0 %then %let sample  = %str(sample);
  %if %length(&setup)   = 0 %then %let setup   = %str(setup);
  %if %length(&npop)    = 0 %then %let npop    = %str(npop);
  %if %length(&n)       = 0 %then %let n       = %str(n);
  %if %length(&mpopi)   = 0 %then %let mpopi   = %str(mpopi);
  %if %length(&mi)      = 0 %then %let mi      = %str(mi);

   proc sort data = &frame;  by &cluster;
   proc sort data = &setup;  by &cluster;

   data idnos_;  set &setup (keep = &cluster &mpopi &mi);  
     retain  nprime_ 0  pprime_ 1  rprime_ 0  u_ 0;
     flag_ = 1;
     if _n_ = 1 then do;
       nprime_  = &npop;
       rprime_ = &npop - &n;
       u_ = ranuni(&seed);
       pprime_ = pprime_*rprime_/nprime_;
     end;
     if pprime_ > u_ then do;
       rprime_ = rprime_ - 1;
       nprime_ = nprime_ - 1;
     end;
     else do;
       output;
       nprime_ = nprime_ - 1;
       pprime_ = 1;
       u_ = ranuni(&seed);
     end;
     if nprime_ > 0 then pprime_ = pprime_*rprime_/nprime_;
     drop pprime_ nprime_ rprime_ u_;

  data stage1_;  merge idnos_ &frame;  by &cluster;
    if flag_ = . then delete;

  data &sample;  set stage1_;  by &cluster;
  retain  nprime_ 0  pprime_ 1  rprime_ 0  u_ 0;
    if first.&cluster then do;
    nprime_  = &mpopi;
    rprime_ = &mpopi - &mi;
    u_ = ranuni(&seed);
    pprime_ = pprime_*rprime_/nprime_;
  end;
  if pprime_ > u_ then do;
    rprime_ = rprime_ - 1;
    nprime_ = nprime_ - 1;
    if nprime_ > 0 then pprime_ = pprime_*rprime_/nprime_;
  end;
  else do;
    output;
    nprime_ = nprime_ - 1;
    pprime_ = 1;
    u_ = ranuni(&seed);
    if nprime_ > 0 then pprime_ = pprime_*rprime_/nprime_;
  end;
  drop flag_ &mpopi &mi pprime_ nprime_ rprime_ u_;

 %if %length(&noprint) = 0 %then %do;
  proc print data = idnos_ noobs;
    title1 'Two-stage Cluster Sample';
    title2 'Clusters Selected at First Stage';
    var &cluster;

   proc print data = &sample;
     title1 'Two-stage Cluster Sample';
     title2 'Final Sample Selected';
     title3 "Output Data Set = &sample";
 %end;
 run; title;
%mend cl2;